home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / kcl / akcl / akcl1615.lha / lsp / autocmp.lsp < prev    next >
Lisp/Scheme  |  1987-12-09  |  2KB  |  52 lines
  1. ;;SAMPLE USAGE:
  2. ;;(def-autocomp foo (a b) (+ a b))
  3. ;;(def-autocomp goo (a b) (- a b))
  4. ;;
  5. ;;(foo 3 4) ==> 7 (after compiling foo and goo together..)
  6. ;;
  7. ;;Note:  Might want to have a *use-count* which only compiles
  8. ;;after *use-count* gets above say 10.  Thus it would only compile
  9. ;;the set of *new-definitions* when there were more than 10.
  10. ;;Would need to change the following slightly. Instead of storing the defun
  11. ;;store the lambda form, and have the autocomp do an apply of the lambda
  12. ;;form while incrementing the *use-count*.  This is probably much better,
  13. ;;since the *use-count* much more accurately reflects the cost of not compiling
  14. ;;This code is obsolete before being used!!  But I have to go now..
  15.  
  16. (require "SLOOP")
  17. (use-package "SLOOP")
  18.  
  19.  
  20. (defvar *new-definitions* nil)
  21.  
  22. (defun compile-new-definitions (name)
  23.   (and name
  24.        (or (member name *new-definitions*)
  25.        (error "~a is not in  *new-definitions*" name)))
  26.   (let ((lisp-file "cmptemp.lisp")(o-file "cmptemp.o"))
  27.     ;;in case somehow order matters..
  28.     (setq *new-definitions* (nreverse *new-definitions*))
  29.     (with-open-file (st lisp-file :direction :output)
  30.             (sloop for v in *new-definitions*
  31.                do (princ (get v 'new-definition) st)))
  32.     (compile-file lisp-file :output-file o-file)
  33.     (load o-file)
  34.     (setq *new-definitions* nil)))
  35.  
  36. (defun autocomp (name args)
  37.   (compile-new-definitions name)
  38.   (apply name args))
  39.  
  40. (defmacro def-autocomp (fun args &rest body)
  41.   (let ((defn (list* 'defun fun args body)))
  42.   `(progn (push ',fun *new-definitions*)
  43.       (setf (get ',fun 'new-definition) ',defn)
  44.       (defun ,fun (&rest args)
  45.         (autocomp ',fun args)))))
  46.       
  47.  
  48.  
  49.  
  50.  
  51.  
  52.